home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / bbsutil / dlx70bbs.zip / DLX70SRC.ZIP / DLX.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-19  |  37KB  |  910 lines

  1. {$debug-}
  2. {$line-}
  3.  
  4. {$include: 'types.int'}
  5. {$include: 'globals.int'}
  6. {$include: 'ident.int'}
  7. {$include: 'load.int'}
  8. {$include: 'utils.int'}
  9. {$include: 'xmodem.int'}
  10. {$include: 'script5.int'}
  11. {$include: 'database.int'}
  12. {$include: 'dlxutil.int'}
  13. {$include: 'dlxinit.int'}
  14.  
  15. program DLX (input, output);
  16.  
  17. {DLX Bulletin Board System V7.0
  18.  
  19.  FREEWARE NOTICE
  20.  
  21.  DLX V7.0 is placed in the public domain by its author, Richard Gillmann.
  22.  Anyone who wishes to may run the program, copy it, or modify it for
  23.  any purpose, including commercial gain.}
  24.  
  25. USES types,globals,ident,load,utils,xmodem,script5,database,dlxutil,dlxinit;
  26.  
  27. const
  28.   bs = chr(8);
  29.   lf = chr(10);
  30.   cr = chr(13);
  31.   ctlc_dos  = 16#23;
  32.   wsize = (number_of_lines+7) div 8;
  33.  
  34. var
  35.   screen_ptr [PUBLIC] : screen_ads_typ;
  36.   row0 [PUBLIC], col0 [PUBLIC], lmc0 [PUBLIC] : integer;
  37.   stifled [PUBLIC] : boolean;
  38.   cancelled [PUBLIC] : boolean;
  39.   to_warn [PUBLIC] : integer;
  40.   to_kill [PUBLIC] : integer;
  41.   bs_local [PUBLIC] : byte;
  42.   wrap0 [PUBLIC] : byte;
  43.   cesxqq [EXTERN]: word;
  44.   doseqq [EXTERN]: word;
  45.   tm_warn : para;
  46.  
  47. {***INTERFACE TO THE COM_PAX2 ASYNCHRONOUS COMMUNICATIONS PACKAGE***}
  48. {$include: 'com_pax2.int'}
  49.  
  50. {***Interface to the PASASM assembler utilities package***}
  51. {$include: 'pasasm.int'}
  52. {$include: 'newasm.int'}
  53.  
  54. {***Interface to KBD library***}
  55. {$include: 'kbd.int'}
  56.  
  57. {***Interface to MS Pascal library***}
  58. function dosxqq(command, parameter: word): byte; EXTERN;
  59. function tics : word; EXTERN;
  60. procedure time(var s : string); EXTERN;
  61. procedure vectin(v : word; procedure i [INTERRUPT]); EXTERN;
  62.  
  63. {***Interface to Brackenridge's More Handles function***}
  64. {$include: 'extndh.int'}
  65.  
  66. {***Special for calling file initialize module***}
  67. procedure globals; EXTERN;
  68.  
  69.  
  70. procedure endoqq [PUBLIC]; {supercedes stub in Pascal library}
  71. begin
  72.   if w.s<>0 and then w^[0].active then restoreh;
  73.   if not alls_well then
  74.     [writeln('*** LINE:',wx:1,', STATE:',q[wx].state:1);
  75.      writeln('*** DEPTH:',macro_depth:1,', INPUT: ',w^[wx].strx)];
  76. end {endoqq};
  77.  
  78. procedure ctl_break [INTERRUPT];
  79. begin
  80.   clean_up;
  81.   ret2dos(3);
  82. end {ctl_break};
  83.  
  84. var
  85.   i,j,k,l,m,n,t : integer;
  86.   wi,wj : word;
  87.   i4 : integer4;
  88.   ch : char;
  89.   str : lstring(long_line);
  90.   p,p2 : para;
  91.   oldtop : integer;
  92.   ix : 0..long_line;
  93.   echo_to_printer : boolean;
  94.   local : integer;
  95.   cmdline: ads of lstring(255);
  96.   doomstime: lstring(5); {planned shutdown time}
  97.  
  98. label
  99.   more_out;
  100.  
  101. begin
  102.  
  103. {Initialize}
  104. cmdline.s := cesxqq;
  105. cmdline.r := 16#80;
  106. globals;{pascal file system}
  107. alls_well:=true;
  108. nill.s:=0; nill.r:=0;
  109. w.s:=0;
  110. bavail:=RETYPE(bpara,nill);
  111. init;{setup stuff for pasasm}
  112.  
  113. {initialize screen pointer}
  114. screen_ptr.s := vidbuf;
  115. screen_ptr.r := 0;
  116. herald;
  117. chkmem;
  118. crit_on;
  119. seed:=tics or 1;
  120. disbpara(newbpara); {force one onto the avail list}
  121. doomstime.len:=0;
  122. w := far_alloc(sizeof(w^));
  123. for i:=1 to ord(cmdline^.len) do
  124.   if cmdline^[i]<=':' and then cmdline^[i]>='0' then
  125.     [doomstime.len:=doomstime.len+1;
  126.      doomstime[doomstime.len]:=cmdline^[i];
  127.      if doomstime.len>=UPPER(doomstime) then break];
  128.  
  129. {Ask sysop which lines to activate}
  130. n:=0;
  131. if number_of_lines>0 then
  132.   [writeln('Select serial line(s) to activate:');
  133.    writeln];
  134. for i:=number_of_lines downto 1 do begin
  135.   write('Activate line ',i:1,'? '); readln(str);
  136.   if str<>null and then uc(str[1])='Y' then
  137.     [w^[i].onscreen:=true; n:=n+1;
  138.      w^[i].baud:=300; w^[i].max_baud:=300;
  139.      w^[i].echo:=true]
  140.   else if decode(str,wj) then
  141.     [w^[i].onscreen:=true; n:=n+1;
  142.      w^[i].baud:=wj; w^[i].max_baud:=wj;
  143.      w^[i].echo:=false]
  144.   else
  145.     w^[i].onscreen:=false;
  146. end {for};
  147. w^[0].onscreen:=true; n:=n+1;
  148. w^[0].baud:=9600; w^[0].max_baud:=9600;
  149. w^[0].echo:=true;
  150. if n>10 and then extndh=-1 then
  151.   writeln('FILES=?');
  152.  
  153. config1;
  154.  
  155. load_em(ch_warn,tm_warn);
  156.  
  157. config2;
  158. to_warn:=18*timeout-540;
  159. to_kill:=18*timeout;
  160.  
  161. config_comm;
  162.  
  163. {main loop}
  164. stifled:=false; cancelled:=false; bs_local:=1;
  165. alls_well:=false;
  166. echo_to_printer:=false;
  167. shutdown_mode:=false;
  168. if n>=(srm1 div 2) then n:=(srm1 div 2)-1; {can only display so many lines}
  169. t:=0;
  170. oldtop:=0;
  171. running:=true;
  172. wx:=0; gstat_line;
  173. vectin(ctlc_dos,ctl_break); {intercept ctrl-break}
  174. {let 'em rip!}
  175. swap_ovl;
  176. for i:=number_of_lines downto 0 do
  177.   [w^[i].echo:=true;
  178.    if i>0 then
  179.      [w^[i].onscreen:=false;
  180.       if w^[i].active then
  181.         [select_port(i); dtr_on]]];
  182. while running do begin
  183.  
  184.   {time processing -- status lines}
  185.   if t<300 then {150 in 5.5}
  186.     t:=t+1
  187.   else begin
  188.     t:=0; allow_break;
  189.     mytime[0]:=chr(8); time(mytime);
  190.     jt:=      (ord(mytime[1])-ord('0'))*10+(ord(mytime[2])-ord('0'));
  191.     jt:=jt*60+(ord(mytime[4])-ord('0'))*10+(ord(mytime[5])-ord('0'));
  192.     jt:=jt*60+(ord(mytime[7])-ord('0'))*10+(ord(mytime[8])-ord('0'));
  193.     if jt<180 then intl_date;
  194.     for wx:=number_of_lines downto 0 do
  195.       if w^[wx].active and then w^[wx].state=going and then
  196.          q[wx].logged_in and then (not q[wx].xover)
  197.         then status_line(wx);
  198.     wx:=0; gstat_line;
  199.     if shutdown_mode then
  200.       [if shutdown_time <= (jt div 60) then
  201.          [running:=false;
  202.           for i:=0 to number_of_lines do
  203.             [if w^[i].active and then w^[i].state=going and then
  204.             q[i].state<snip then
  205.                [w^[i].chat:=-1; q[i].cleanup:='I';
  206.                 w^[i].node_type:=nt_compute; q[i].state:=cleanup1]
  207.              else if i>0 and then q[i].logged_in then
  208.                running:=true]]]
  209.     else if doomstime.len>=4 and then eq2(mytime,doomstime) then
  210.       [doseqq:=0; shut_down(20)];
  211.   end {time processing};
  212.  
  213.   {do function keys}
  214.   if f_count>0 then
  215.     [k:=f_recv;
  216.      case k of
  217.      59..66 : {F1 thru F8 = show lines in small groups}
  218.        [k:=k-58;
  219.         if wsize*(k-1)+1<=number_of_lines then
  220.           [for i:=number_of_lines downto 1 do w^[i].onscreen:=false;
  221.            l:=0; {next available row}
  222.            for i:=wsize*k downto wsize*(k-1)+1 do begin
  223.              if i>number_of_lines then cycle;
  224.              if w^[i].active then w^[i].onscreen:=true;
  225.              w^[i].top:=l; w^[i].bot:=w^[i].top+(srm1 div (wsize+1))-2;
  226.              w^[i].stat:=w^[i].bot+1; l:=w^[i].stat+1;
  227.              scrollup(w^[i].top*256+0,w^[i].bot*256+scm1,nattr,0);
  228.              w^[i].row:=w^[i].top;
  229.              if w^[i].active and then w^[i].state=going and then
  230.                 q[i].logged_in and then (not q[i].xover)
  231.                then status_line(i);
  232.          movesl2(ads w^[i].stat_char^.msg[1],
  233.                   ads screen_ptr^[w^[i].stat,0].character,screen_cols);
  234.          movesl2(ads w^[i].stat_attr^.msg[1],
  235.                   ads screen_ptr^[w^[i].stat,0].atrb,screen_cols);
  236.            end {for};
  237.            if w^[0].top>l then
  238.          scrollup(l*256+0,(w^[0].top-1)*256+scm1,nattr,0);
  239.            if row0=oldtop and then col0=0 then
  240.              [w^[0].row:=l; row0:=l; setcp(l,0)];
  241.            oldtop:=l; w^[0].top:=l;
  242.            w^[0].bot:=screen_rows-3; w^[0].stat:=screen_rows-2;
  243.            if row0<w^[0].top then
  244.              [row0:=w^[0].top; w^[0].row:=row0;
  245.               col0:=0; w^[0].col:=0;
  246.               lmc0:=0; w^[0].lmc:=0;
  247.               setcp(row0,0)];
  248.            scrollup(w^[0].stat*256+0,w^[0].stat*256+scm1,iattr,0);
  249.            if w^[0].state=going and then
  250.               q[0].logged_in and then (not q[0].xover)
  251.              then status_line(0);
  252.        movesl2(ads w^[0].stat_char^.msg[1],
  253.                ads screen_ptr^[w^[0].stat,0].character,screen_cols);
  254.        movesl2(ads w^[0].stat_attr^.msg[1],
  255.                 ads screen_ptr^[w^[0].stat,0].atrb,screen_cols);
  256.            wx:=0; gstat_line]];
  257.      67 : {F9 = show all lines}
  258.        [m:=0; {number of windows displayed so far}
  259.         l:=0; {next available row}
  260.     for i:=1 to number_of_lines do
  261.       if w^[i].active and then m<n
  262.         then [w^[i].onscreen:=true; m:=m+1]
  263.         else w^[i].onscreen:=false;
  264.         for i:=number_of_lines downto 1 do
  265.           if w^[i].active and then w^[i].onscreen then
  266.             [w^[i].top:=l; w^[i].bot:=w^[i].top+(srm1 div n)-2;
  267.              w^[i].stat:=w^[i].bot